perm filename CRE[G,BGB] blob
sn#050722 filedate 1973-06-27 generic text, type T, neo UTF8
00100 COMMENT ⊗ VALID 00021 PAGES
00200 C REC PAGE DESCRIPTION
00300 C00001 00001
00400 C00003 00002 CRE3 - CART'S EYE - CONTOUR,REGION,EDGE - BGB - APRIL 1973.
00500 C00005 00003 INITIALIZATION - SA: AND REE:
00600 C00007 00004 SUBR(TTY) TTY LISTEN.
00700 C00008 00005 --- COMMAND JUMP TABLE ASCII 00 TO 37.
00800 C00009 00006 --- COMMAND JUMP TABLE ASCII 40 TO 77.
00900 C00010 00007 --- COMMAND JUMP TABLE ASCII 100 TO 137.
01000 C00012 00008 XWINDO: WINDOW SCROLLING COMMANDS.
01100 C00013 00009 XLINK: LINK FOLLOWING COMMANDS.
01200 C00015 00010 XRESET "Z" COMMAND. NEXIMG.
01300 C00018 00011 SUBR(XXNAME) "N" - NAME THE FILM.
01400 C00019 00012 XFLAGS:
01500 C00021 00013 SUBR(XCUT). MAKE CUTS COMMAND "C".
01600 C00024 00014 SUBR(XATP). AUTOMATIC TURN TABLE PERCEPTION.
01700 C00026 00015 SUBR(XTAKE). "T" TAKE TELEVISION PICTURE.
01800 C00029 00016 SUBR(XXPAND) HISTOGRAM CUT HIGH AND CUT LOW.
01900 C00031 00017 SUBR(REMAP) RE MAP TVBUF.
02000 C00032 00018 AWIDTH - SELECT ARC WIDTH.
02100 C00035 00019 XCART. CART CONTROL COMMANDS.
02200 C00037 00020 CART SPACE WAR JOB.
02300 C00039 00021 XHELP:
02400 C00043 ENDMK
02500 C⊗;
00100 ;CRE3 - CART'S EYE - CONTOUR,REGION,EDGE - BGB - APRIL 1973.
00200 TITLE CRE
00300
00400 EXTERN QBLK,SX,SY,DEL,MAG
00500 EXTERN DPYBLK,DPYIMG,DPYHIS,CROP
00600 EXTERN MKCON
00700 EXTERN TVXGP,PLOTO,MORCOR
00800 EXTERN QIMAGE,QNODE
00900
01000 INTERN FLGBGB,FLGDD,FLGIII
01100 INTERN CTRL,META,CHR,VCUT
01200 INTERN ARCWID
01300
01400 ;CONTROL FLAGS.
01500 INTERN FLGHIS
01600 FLGHIS:0 ;HISTOGRAM IS VALID.
01700 VCUT:-14 ;VECTOR DISPLAY CONTRAST THRESHOLD.
01800 FLGBGB:0 ;RUNNING UNDER A BGB PPPN.
01900 FLGDD:0 ;RUNNING AT A DATA DISC.
02000 FLGIII:0 ;RUNNING AT A III DISPLAY.
02100
02200 ;ARC WIDTH PROPORTIONAL TO CONTRAST TABLE FOR MKARCS.
02300 ARCWID:
02400 FOR I←0,3{1.0↔}
02500 FOR I←4,5{0.9↔}
02600 FOR I←6,12{0.8↔}
02700 FOR I←13,17{0.7↔}
02800 FOR I←20,37{0.6↔}
02900 FOR I←40,77{0.5↔}
03000 0
03100
03200 ;TELETYPE COMMAND STATE.
03300 DECLARE{CTRL,META,CHR}
00100 ;INITIALIZATION - SA: AND REE:
00200 ;----------------------------------------------------------------
00300
00400 PDL: BLOCK 100
00500
00600 ;START ADDRESS
00700 SA: LAC 17,[IOWD 100,PDL]
00800 CALL(MORCOR)
00900 CALL(SEGTV)
01000
01100 ;RE-ENTRY ADDRESS.
01200 REE: LACI .↔DAC 124
01300 SETO↔GETLIN ;GET LINE CHARACTERISTICS.
01400 CAMN[-1]↔SETZ ;JOB DETACHED.
01500 DZM FLGIII↔TLNE(1B0)↔SETOM FLGIII
01600 DZM FLGDD↔ TLNE(1B4)↔SETOM FLGDD
01700 PPIOT 2,-=250
01800 PPIOT 3,3003
01900 DZM QBLK
02000 MOVEI 20↔CRLF↔SOJG .-1
02100 SETZ↔GETPPN↔CDR
02200 CAIN'BGB'↔SETOM FLGBGB
02300 LAC 17,[IOWD 100,PDL]
02400 CALL(CROP)
02500 CALL(DPYIMG)
02600 PUSHJ TTY
02700 EXIT
02800 ;6/12/72----------------------------------------------------------
02900 ;TELETYPE COMMAND STATE.
03000
03100 ;SEGTV - GET OLD TVSEG.
03200 SUBR(SEGTV)-------------------------------------------------------
03300 EXTERN HI
03400 ;MAKE A NEW TVSEG.
03500 LACI HI↔CORE2↔GO[FATAL(CAN'T GET A SECOND SEGMENT.)]
03600 LAC[SIXBIT/*CRE3*/]↔SETNM2↔JFCL
03700 SETZ↔SEGNUM↔DAC TVSEG
03800 LAC[%+1(%)]↔DZM %↔BLT HI-1
03900 POP0J
04000 TVSEG:0
04100 ;16/12/72---------------------------------------------------------
00100 SUBR(TTY) ;TTY LISTEN.
00200 BEGIN TTY;--------------------------------------------------------
00300 L0: CRLF
00400 L1: OUTCHR["*"]
00500 L2: INCHRW
00600 DZM CTRL↔TRZE 200↔SETOM CTRL
00700 DZM META↔TRZE 400↔SETOM META
00800 CAIN 0,15↔GO L1+1 ;CARRIAGE RETURN.
00900 CAIN 0,12↔GO L1 ;LINE FEED.
01000 CAIL 140↔SUBI 40 ;SUPPRESS LOWER CASE.
01100 DAC CHR
01200 LAC 1,CHR
01300 PUSHJ P,@A00(1)
01400 GO L0 ;CRLF-STAR.
01500 GO L2 ;NOTHING.
01600 GO L1 ;STAR.
01700 BEND TTY; BGB 19 APRIL 1973 --------------------------------------
00100 ; --- COMMAND JUMP TABLE ASCII 00 TO 37.
00200 A00: NOP ;null
00300 NOP ;"↓"
00400 NOP ;"α"
00500 NOP ;"β"
00600
00700 XLINK ;"∧"
00800 NOP ;"¬"
00900 NOP ;"ε"
01000 NOP ;"π"
01100
01200 NOP ;"λ"
01300 NOP ;tab
01400 NOP ;lf
01500 NOP ;vt
01600
01700 NOP ;ff
01800 NOP ;cr
01900 NOP ;"∞"
02000 NOP ;"∂"
02100
02200 XLINK ;"⊂"
02300 XLINK ;"⊃"
02400 XLINK ;"∩"
02500 XLINK ;"∪"
02600
02700 NOP ;"∀"
02800 NOP ;"∃"
02900 XLINK ;"⊗"
03000 XMOVIE ;"↔" RUN THRU THE IMAGES AS A MOVIE.
03100
03200 NOP ;"_"
03300 XTDPY ;"→"
03400 NOP ;"~"
03500 NOP ;"≠"
03600
03700 XLINK ;"≤"
03800 XLINK ;"≥"
03900 NOP ;"≡"
04000 XLINK ;"∨"
04100
00100 ; --- COMMAND JUMP TABLE ASCII 40 TO 77.
00200 A40: XWINDO ;" "
00300 XLINK ;"!"
00400 NOP ;"""
00500 XCRLFS ;"#"
00600
00700 NOP ;"$"
00800 NOP ;"%"
00900 NOP ;"&"
01000 NOP ;"'"
01100
01200 XWINDO ;"("
01300 XWINDO ;")"
01400 XWINDO ;"*"
01500 XLINK ;"+"
01600
01700 XLINK ;","
01800 XWINDO ;"-"
01900 XLINK ;"."
02000 XWINDO ;"/"
02100
02200 NOP ;"0"
02300 NOP ;"1"
02400 NOP ;"2"
02500 NOP ;"3"
02600
02700 NOP ;"4"
02800 NOP ;"5"
02900 NOP ;"6"
03000 NOP ;"7"
03100
03200 NOP ;"8"
03300 NOP ;"9"
03400 XWINDO ;":"
03500 XWINDO ;";"
03600
03700 XLINK ;"<"
03800 NOP ;"="
03900 XLINK ;">"
04000 XHELP ;"?"
00100 ; --- COMMAND JUMP TABLE ASCII 100 TO 137.
00200
00300 A100: NOP ;"@"
00400 XATP ;"A" AUTOMATIC TURNTABLE PERCEPTION.
00500 XCART; *;"B" DRIVE BACKWARDS.
00600 XCUT ;"C" MAKE THRESHOLD CUT.
00700
00800 XFLAGS ;"D" DISABLE PROCESSES.
00900 XFLAGS ;"E" ENABLE PROCESSES.
01000 XCART; *;"F" DRIVE FORWARDS.
01100 NOP ;"G"
01200
01300 DPYHIS ;"H" HISTOGRAM, "αH" ,"βH" BI-MODAL CUT.
01400 XINPUT ;"I" INPUT.
01500 XXPAND ;"J" TWO CUTS AT 5% FROM ENDS.
01600 NOP ;"K"
01700
01800 XCART; *;"L" TURN LEFT. "αL" PAN CAMERA LEFT.
01900 XMATCH ;"M" MATCH AND LINK IMAGES IN TIME.
02000 XXNAME ;"N" NAME THE FILM.
02100 XOUTPUT ;"O" OUTPUT.
02200
02300 PLOTO ;"P" PLOT OUTPUT FILE.
02400 XCUTS ;"Q" EQUI-SPACED CUTS.
02500 XCART; *;"R" TURN RIGHT. "αR" PAN CAMERA RIGHT.
02600 XSELECT ;"S" SELECT CAMERA, "αS" BCLIP, "βS" TCLIP.
02700
02800 XTAKE ;"T" TAKE TELEVISON PICTURE. "αT" SIXBIT.
02900 XTABLE↑ ;"U" ENTER TURN TABLE SERVO SUB COMMAND.
03000 XCART ;"V" XCART DIAGONOSTIC COMMAND MODE.
03100 AWIDTH ;"W" SET ARC WIDTH TABLE.
03200
03300 TVXGP ;"X" XEROX OUTPUT.
03400 XTABLE↑ ;"Y" TURN TABLE.
03500 XRESET ;"Z" ZERO DATA BUFFERS.
03600 NOP ;"[" OR "{"
03700
03800 XWINDO ;"\" OR "|"
03900 NOP ;"]" OR ALT
04000 NOP ;"↑" OR "}"
04100 XTDPY ;"←" OR RUB
04200
04300 NOP: OUTCHR[9]↔OUTCHR CHR↔OUTSTR[ASCIZ/ NO OPERATION./]
04400 POP0J
00100 XWINDO: ;WINDOW SCROLLING COMMANDS.
00200 BEGIN XWINDO;-----------------------------------------------------
00300 LAC CHR
00400 CAIN 0," "↔GO L2
00500 CAIN 0,":"↔GO[LAC SX↔FAD DEL↔DAC SX↔GO L2]
00600 CAIN 0,";"↔GO[LAC SX↔FSB DEL↔DAC SX↔GO L2]
00700 CAIN 0,")"↔GO[LAC SY↔FAD DEL↔DAC SY↔GO L2]
00800 CAIN 0,"("↔GO[LAC SY↔FSB DEL↔DAC SY↔GO L2]
00900 CAIN 0,"/"↔GO[LAC DEL↔FSC -1↔DAC DEL↔GO L2]
01000 CAIN 0,"\"↔GO[LAC DEL↔FSC 1↔DAC DEL↔GO L2]
01100 CAIN 0,"*"↔GO[LAC MAG↔FMP[1.5]↔DAC MAG↔GO L2]
01200 CAIN 0,"-"↔GO[LAC MAG↔FDV[1.5]↔DAC MAG↔GO L2]
01300 L2: CALL(CROP)↔CALL(DPYIMG)↔AOS(P)↔POP0J
01400 BEND XWINDO; BGB 19 APRIL 1973 -----------------------------------
00100 XLINK: ;LINK FOLLOWING COMMANDS.
00200
00300 COMMENT/ Replace the QBLK with one of its own links. Empty links
00400 and demands for positions that are not links are ignored by means
00500 of checking the node's relocation bits./
00600
00700 BEGIN XLINK;------------------------------------------------------
00800 LAC CHR
00900 CAIN"!"↔GO[DZM QBLK↔GO L]
01000 CAIE"⊗"↔CAIN"+"↔GO[LAC FILM↔DAC QBLK↔GO L]
01100 SKIPN 2,QBLK↔POP0J ;GET THE QBLK NODE.
01200 RELOC 3,2 ;RELOCATION BITS.
01300 CAIN","↔LACI 2000 ;WORD0.
01400 CAIN"."↔LACI 1000
01500 CAIN"<"↔LACI 2001 ;WORD1.
01600 CAIN">"↔LACI 1001
01700 CAIN"∪"↔LACI 2003 ;WORD3.
01800 CAIN"∩"↔LACI 1003
01900 CAIN"≤"↔LACI 2004 ;WORD4.
02000 CAIN"≥"↔LACI 1004
02100 CAIN"⊂"↔LACI 2005 ;WORD5.
02200 CAIN"⊃"↔LACI 1005
02300 CAIN"∨"↔LACI 2006 ;WORD6.
02400 CAIN"∧"↔LACI 1006
02500 TRNN 3000↔POP0J ;NO HIT ON COMMAND CHR.
02600 DAC 1↔ANDI 1,7↔LSH -9
02700 LDB 3,[POINT 3,3,20↔POINT 3,3,23↔0↔POINT 3,3,26
02800 POINT 3,3,29↔POINT 3,3,32↔POINT 3,3,35](1)
02900 TDNN 3,0↔POP0J ;AIN'T NO LINK THERE.
03000 ADD 1,2↔LAC 3,(1)
03100 TRNN 0,1↔MOVSS 3↔CDR 3
03200 SKIPE↔DAC QBLK
03300 L: LAC 1,QBLK↔TEST 1,IBIT↔GO .+3
03400 DAC 1,QIMAGE↔CALL(DPYIMG)
03500 CALL(DPYBLK)
03600 AOS(P)↔POP0J
03700 BEND XLINK; BGB 19 APRIL 1973 ------------------------------------
03800
03900 XCRLFS: LACI 20↔CRLF↔SOJG .-1↔POP0J
00100 ;XRESET "Z" COMMAND. NEXIMG.
00200 SUBR(XRESET)------------------------------------------------------
00300 BEGIN XRESET
00400 EXTERN AVAIL2,NODCNT,FILM,CRE44
00500 SKIPE META↔GO[SETZB 0,1↔UPGIOT 16,↔POP0J]
00600 SKIPE CTRL↔GO L
00700 DZM QBLK↔DZM QIMAGE
00800 LAC CRE44↔CORE↔JFCL↔DZM CRE44
00900 DZM AVAIL2↔DZM NODCNT↔DZM FILM
01000 CALL(MORCOR)
01100 L: DZM SX↔DZM SY
01200 LAC[32.0]↔DAC DEL
01300 LAC[3.4]↔DAC MAG
01400 CALL(CROP)
01500 CALL(DPYIMG)
01600 POP0J
01700 BEND XRESET; BGB 31 DECEMBER 1972 --------------------------------
01800
01900 SUBR(XMOVIE)------------------------------------------------------
02000 BEGIN XMOVIE;NEXT IMAGE - BGB - 11 DEC 72.
02100 SKIPN 1,QIMAGE↔POP0J
02200 CCW 2,1↔SKIPE CTRL↔CW 2,1
02300 DAC 2,QIMAGE
02400 CALL(DPYIMG)
02500 SKIPE META↔GO[INCHRS↔GO XMOVIE↔POP0J]
02600 POP0J
02700 BEND;12/11/72-----------------------------------------------------
02800
02900 SUBR(XMATCH) "M" - MATCH AND LINK IMAGES IN TIME.
03000 BEGIN XMATCH;-----------------------------------------------------
03100 EXTERN CMCNII
03200 LAC 2,FILM↔SON 2,2 ;FIRST IMAGE TAKEN.
03300 CW 2,2 ; LAST IMAGE TAKEN.
03400 LAC 1,2↔CW 1,1 ;PENULT IMAGE TAKEN.
03500 CALL(CMCNII,1,2)
03600 POP0J
03700 BEND XMATCH; BGB 16 APRIL 1973 -----------------------------------
03800
03900 XTDPY:; "←" "→" DISPLAY TIMED LINKED POLYGON OF QBLK.
04000 EXTERN TIMDPY
04100 SKIPN 1,QBLK↔POP0J
04200 TEST 1,PBIT↔POP0J
04300 PUSH P,QBLK
04400 LAC CHR↔CAIN "←"↔GO[PUSHJ P,TIMDPY+1↔POP0J]
04500 PUSHJ P,TIMDPY↔POP0J
00100 SUBR(XXNAME) "N" - NAME THE FILM.
00200 BEGIN XXNAME;------------------------------------------------------
00300 EXTERN CREDPY,FNAME,FNAME6
00400 OUTSTR[ASCIZ/ FILM = /]
00500 LAC 1,[POINT 7,FNAME,-1] ;ASCII.
00600 LAC 2,[POINT 6,FNAME6,-1] ;SIXBIT.
00700 LACI 3,6
00800 L: INCHWL
00900 CAIN 15↔GO[INCHWL↔GO EOL]
01000 CAIL"a"↔SUBI 40
01100 IDPB 1
01200 SUBI 40
01300 IDPB 2
01400 SOJG 3,L
01500 EOL: SETZ↔SKIPE 3↔GO[IDPB 1↔IDPB 2↔SOJA 3,.-1]
01600 CALL(CREDPY)
01700 AOS(P)↔AOS(P)↔POP0J
01800 BEND XXNAME; BGB 17 APRIL 1973 ------------------------------------
01900
00100 XFLAGS:
00200 BEGIN XFLAGS;-----------------------------------------------------
00300 EXTERN ENEST,ECONT,ESMOO,ECOMP
00400
00500 LAC CHR↔CAIN"E"↔GO L9
00600 SETZM ENEST↔SETZM ECONT↔SETZM ESMOO↔SETZM ECOMP↔POP0J
00700 L9: SETOM ENEST↔SETOM ECONT↔SETOM ESMOO↔SETOM ECOMP↔POP0J
00800 BEND XFLAGS; BGB 20 APRIL 1973 ----------------------------------
00900
01000 XINPUT:; "I" - INPUT COMMANDS.
01100 EXTERN CREIN,TVDSKI
01200 SKIPN CTRL↔GO[DZM FLGHIS
01300 CALL(TVDSKI,[-1])↔GO SKPOPJ]
01400 CALL(CREIN)
01500 LAC 1,FILM↔SON 1,1↔DAC 1,QIMAGE
01600 CALL(DPYIMG)
01700 SKPOPJ: AOS(P)↔AOS(P)↔POP0J
01800
01900 XOUTPUT:; "O" - OUTPUT COMMANDS.
02000 EXTERN CREOUT,TVDSKO
02100 SKIPN CTRL↔GO[
02200 CALL(TVDSKO)↔GO SKPOPJ]
02300 CALL(CREOUT)↔GO SKPOPJ
02400
00100 SUBR(XCUT). ;MAKE CUTS COMMAND "C".
00200 BEGIN XCUT;-------------------------------------------------------
00300
00400 ;DISTINGUISH CUTTING A FILM OF FILES & CUTTING SINGLE IMAGE.
00500 DZM FFLAG#↔LAC 1,QBLK
00600 CAMN 1,FILM↔SETOM FFLAG#
00700 DZM FRAME#
00800
00900 ;DECODE THE ARGUMENTS.
01000 DZM QQ2↔DZM QQ3
01100 L1: SETZ 1,↔INCHWL
01200 CAIN 15↔GO[CALL(L4)↔GO L2]
01300 CAIL 0,"0"↔CAILE 0,"7"↔GO[CALL(L4)↔GO L1]
01400 IMULI 1,=8↔ANDI 17↔ADD 1,0↔GO L1+1
01500
01600 L2: INCHWL ;PICK UP THE LINE FEED.
01700 SKIPN FFLAG↔GO L3 ;SKIP WHEN FILMING.
01800 AOS FRAME
01900 CALL(TVDSKI,FRAME)
02000 SKIPN 1↔POP0J
02100
02200 L3: SKIPE META↔GO L5
02300 LAC QQ2↔IOR QQ3 ;MAKE SURE THERE ARE SOME CUTS.
02400 SKIPN↔POP0J
02500 CALL(MKCON,QQ2,QQ3) ;CONTOUR THE VIDEO IMAGE.
02600 CALL(DPYIMG) ;DISPLAY IMAGE.
02700 SKIPN FFLAG↔POP0J ;POTENTIAL EXIT.
02800 GO L2+1
02900
03000 ;TURN ON SPECIFIED BIT POSITION.
03100 L4: SKIPN 1↔POP0J
03200 CAIL 1,=64↔POP0J
03300 MOVNS 1↔SETZ 3,
03400 SLACI 2,1B18↔LSHC 2,(1)
03500 IORM 2,QQ2↔IORM 3,QQ3
03600 POP0J
03700
03800 ;RAW CONTOURS TO XGP.
03900 L5: SKIPN CTRL↔GO L3+2
04000 CALL(VICXGP,QQ2,QQ3)↔EXTERN VICXGP
04100 POP0J
04200 BEND;1/17/73------------------------------------------------------
04300 DECLARE{QQ2,QQ3} ;CONTOUR CUT INDICATOR BITS.
00100 SUBR(XATP). ;AUTOMATIC TURN TABLE PERCEPTION.
00200 BEGIN ATP;___________________________________________________________
00300 OUTSTR[ASCIZ/ NUMBER OF IMAGES DESIRED = /]
00400 CALL(REALIN↑)↔FIXX↔DAC IMGCNT#
00500 L1: OUTSTR[ASCIZ/ T/]
00600 CALL(XTAKE)
00700 CALL(MKCON,QQ2,QQ3)
00800 CALL(DPYIMG)
00900 CALL(XMATCH)
01000 CRLF
01100 SOSG IMGCNT↔GO L2
01200 LACI "Y"↔CALL(XTABLE↑) ;TURN THE TABLE.
01300 GO L1
01400 L2: OUTSTR[ASCIZ/END OF AUTOMATIC TURNTABLE FILMING.
01500 /]↔ POP0J
01600 BEND ATP;BGB 25 JUNE 1973 ___________________________________________
01700
01800 SUBR(XCUTS). ;MAKE CUTS COMMAND "Q".
01900 BEGIN XCUTS;------------------------------------------------------
02000 SETZ 1,
02100 SKIPE CTRL↔LACI 1,1
02200 SKIPE META↔ADDI 1,2
02300 CALL(MKCON,{Q1(1)},{Q2(1)})
02400 CALL(DPYIMG)
02500 POP0J
02600
02700 ;THREE, SEVEN, EIGHT OR FIFTEEN CUTS - EQUALLY SPACED.
02800 Q1: 1B16 +1B32
02900 1B8+1B16+1B24+1B32 ↔ 1B4+1B12+1B20+1B28
03000 1B8+1B16+1B24+1B32 + 1B4+1B12+1B20+1B28
03100 Q2: 1B12
03200 1B4+1B12+1B20 ↔ 1B0+1B8+1B16+1B24
03300 1B4+1B12+1B20 + 1B0+1B8+1B16+1B24
03400
03500 BEND XCUTS; BGB 9 DECEMBER 1972 -----------------------------------
03600
00100 SUBR(XTAKE). "T" TAKE TELEVISION PICTURE.
00200 BEGIN XTAKE
00300 EXTERN TVIN6,TVIN4
00400 SETOM FLGHIS ;HISTOGRAM WILL BE ACCUMULATED.
00500 SLACI %+17↔LAPI .+3
00600 SPCWGO↔SKIPA↔DISMIS ;LOCKIN CORE.
00700 SKIPE CTRL↔GO[
00800 CALL(TVIN6)↔GO .+2]
00900 CALL(TVIN4)
01000 SPCWAR'SSW'↔POP0J ;UNLOCK CORE.
01100 BEND XTAKE;(BGB)14-DEC-72
01200 ;_________________________________________________________________
01300 SUBR(XSELECT). "S" SELECT CAMERA.
01400 BEGIN XSELECT;----------------------------------------------------
01500 EXTERN TVCLIP
01600 LAC CTRL↔AND META↔SKIPE↔GO L4
01700 SKIPE CTRL↔GO L2↔SKIPE META↔GO L3
01800
01900 ;SELECT CAMERA.
02000 L1: LDB[POINT 2,TVCLIP,26]↔IORI 60
02100 OUTSTR[ASCIZ/ CHANGE CAMERA /]
02200 OUTCHR↔OUTSTR[ASCIZ/ TO /]
02300 INCHRW↔CAIE 15↔DPB[POINT 2,TVCLIP,26]↔POP0J
02400
02500 ;SELECT BOTTOM CLIP LEVEL.
02600 L2: LDB[POINT 3,TVCLIP,20]↔IORI 60
02700 OUTSTR[ASCIZ/ CHANGE BCLIP /]
02800 OUTCHR↔OUTSTR[ASCIZ/ TO /]
02900 INCHRW↔CAIE 15↔DPB[POINT 3,TVCLIP,20]↔POP0J
03000
03100 ;SELECT TOP CLIP LEVEL.
03200 L3: LDB[POINT 3,TVCLIP,23]↔IORI 60
03300 OUTSTR[ASCIZ/ CHANGE TCLIP /]
03400 OUTCHR↔OUTSTR[ASCIZ/ TO /]
03500 INCHRW↔CAIE 15↔DPB[POINT 3,TVCLIP,23]↔POP0J
03600
03700 ;SHRINQ NODE SPACE.
03800 L4: CALL(SHRINQ)↔EXTERN SHRINQ
03900 POP0J
04000
04100 BEND XSELECT; BGB 6 DECEMBER 1972 --------------------------------
00100 SUBR(XXPAND); HISTOGRAM CUT HIGH AND CUT LOW.
00200 BEGIN XXPAND;-----------------------------------------------------
00300 EXTERN HISTO,HISTOG
00400 ACCUMULATORS{Q1,Q2,HI,LO}
00500 SKIPN CTRL↔GO L1
00600 LACI 1,77↔SETZ↔DAC 0,TVMAP(1)↔AOS↔SOJGE 1,.-2↔GO L3
00700 L1: CALL(HISTOG)
00800 LACI HI,77↔DZM LO↔SETZB Q1,Q2
00900 LACI 6↔IMULI =62208↔IDIVI =100↔DAC 1 ;6% RULE.
01000
01100 ;COME IN FROM THE EXTREMES 6 PER CENT.
01200 SETZ↔ADD HISTO(LO)↔CAMGE 1↔AOJA LO,.-2
01300 SETZ↔ADD HISTO(HI)↔CAMGE 1↔SOJA HI,.-2
01400 L2: CAML LO,HI↔POP0J
01500
01600 ;LOOK FOR LOCAL MINIMUM.
01700 ; LAC HISTO(LO)↔CAML HISTO+1(LO)↔AOJA LO,L2
01800 ; LAC HISTO(LO)↔CAML HISTO-1(LO)↔AOJA LO,L2
01900 ; LAC HISTO(HI)↔CAML HISTO+1(HI)↔SOJA HI,L2
02000 ; LAC HISTO(HI)↔CAML HISTO-1(HI)↔SOJA HI,L2
02100
02200 ;MAKE THE TV MAP.
02300 SETZB 0,1
02400 DAC 0,TVMAP(1)↔CAMG 1,LO↔AOJA 1,.-2 ;00 TO LO → 00.
02500 LACI 77↔LACI 1,77
02600 DAC 0,TVMAP(1)↔CAML 1,HI↔SOJA 1,.-2 ;77 TO HI → 77.
02700 SLACI 2,77↔LAC 1,HI↔SUB 1,LO↔IDIV 2,1 ;DELTA INTENSITY.
02800 SETZ↔LAC 1,LO↔AOS 1
02900 HLRZM 0,TVMAP(1)↔ADD 0,2
03000 CAMGE 1,HI↔AOJA 1,.-3
03100 L3: CALL(REMAP)
03200 POP0J
03300 BEND XXPAND;------------------------------------------------------
03400
00100 SUBR(REMAP); RE MAP TVBUF.
00200 BEGIN REMAP;------------------------------------------------------
00300 EXTERN TVBUF,FLGHIS
00400 DZM FLGHIS
00500 LAC[XWD L,2]↔BLT 8↔GO 2
00600 L: ILDB 1,7 ;2
00700 LAC 1,TVMAP(1) ;3 REPLACE BYTE ACCORDING TO TABLE TVMAP.
00800 DPB 1,7
00900 SOJG 8,2 ;5
01000 POP0J ;6
01100 POINT 6,TVBUF ;7 INITIAL TV BUFFER POINTER.
01200 =62208 ;8 NUMBER OF PIXELS.
01300 BEND REMAP; BGB 6 MAY 1973 ----------------------------------------
01400
01500 INTERN TVMAP
01600 TVMAP: BLOCK 100
01700
00100 ;AWIDTH - SELECT ARC WIDTH.
00200 SUBR(AWIDTH)------------------------------------------------------
00300 BEGIN AWIDTH
00400 EXTERN REALIN
00500 ACCUMULATORS{DEL,XLO,XHI,X1,X2}
00600 TDCA X2,X2↔INCHWL
00700 L1: OUTSTR[ASCIZ/ #/]
00800
00900 INCHRW↔CAIN 15↔GO L1-1
01000 CAIL"0"↔CAILE"7"↔GO L4
01100 ANDI 7↔LSH 3↔DAC 1
01200
01300 INCHRW↔CAIN 15↔GO L1-1
01400 CAIL"0"↔CAILE"7"↔GO L4
01500 ANDI 7↔ADD 1,0↔EXCH 1,X2↔DAC 1,X1
01600
01700 L2: CALL(TYPOUT)
01800 CALL(REALIN)
01900 JUMPLE .+3↔CAMGE[100.0]↔CALL(ALTER)
02000 CAIE 1,12↔GO .+3↔OUTCHR[15]↔AOJA X2,L3
02100 CAIN 1,15↔INCHWL
02200 CAIE 1,175↔GO L1↔CRLF↔SOJA X2,L3
02300 L3: CAILE X2,77↔LACI X2,77
02400 CAIGE X2,00↔LACI X2,00
02500 LAC[ASCIZ/ #00/]
02600 DPB X2,[POINT 3,0,27]↔ROT X2,-3
02700 DPB X2,[POINT 3,0,20]↔ROT X2, 3
02800 OUTSTR↔GO L2
02900 L4: CRLF↔POP0J
03000
03100 TYPOUT: LAC ARCWID(X2)↔FMPR[100.0]↔FIXX
03200 IDIVI 0,=1000
03300 SKIPE↔IORI"0"↔IORI" " ↔DPB 0,[POINT 7,STR,13]
03400 IDIVI 1,=100 ↔IORI 1,"0"↔DPB 1,[POINT 7,STR,20]
03500 IDIVI 2,=10 ↔IORI 2,"0"↔DPB 2,[POINT 7,STR,34]
03600 IORI 3,"0"↔DPB 3,[POINT 7,STR+1,6]
03700 OUTSTR STR↔POP0J
03800 STR: ASCIZ/ 99.99 /
03900
04000 ALTER: DAC ARCWID(X2)
04100 LAC XLO,X1↔LAC XHI,X2↔CAMLE XLO,XHI↔EXCH XLO,XHI
04200 LAC XHI↔SUB XLO↔FLOAT
04300 LAC DEL,ARCWID(XHI)↔FSBR DEL,ARCWID(XLO)↔FDVR DEL,0
04400 LAC ARCWID(XLO)↔AOS XLO
04500 L5: CAML XLO,XHI↔POP0J
04600 FADR DEL↔DAC ARCWID(XLO)↔AOJA XLO,L5
04700
04800 BEND AWIDTH;BGB 16 DECEMBER 1972 ---------------------------------
00100 ;XCART. CART CONTROL COMMANDS.
00200 SUBR(XCART)-------------------------------------------------------
00300 BEGIN XCART
00400 OPDEF RADIO[7702B11]
00500 LAC 2,CHR ;INITIAL COMMAND CHARACTER.
00600 CAIN 2,"V"↔GO L0
00700 SKIPE CTRL↔TRO 2,200↔SKIPA ;SHIT.
00800 M0: INCHRW 2 ;WAIT FOR COMMAND CHARACTER.
00900 DZM CNT0↔DZM CNT1 ;ZIP TIME OF ANY PREVIOUS COMMAND.
01000 DZM CTRL↔TRZE 2,200↔SETOM CTRL
01100 DAC 2,CHR
01200 SLACI 0,=5 ;ONE-THIRD OF A SECOND.
01300
01400 ;DRIVE ONE MINUTE FORWARDS OR BACKWARDS.
01500 CAIN 2,"F"↔GO[LAC 1,[(=900)12]↔GO M1]
01600 CAIN 2,"B"↔GO[LAC 1,[(=900)12]↔LAPI 0,2↔GO M1]
01700 SKIPE CTRL↔GO .+5
01800
01900 ;STEERING 5 SECONDS LEFT OR RIGHT.
02000 CAIN 2,"L"↔GO[LAC 1,[(=75)11]↔LAPI 1↔GO M1]
02100 CAIN 2,"R"↔GO[LAC 1,[(=75)11]↔LAPI 0↔GO M1]
02200
02300 ;CAMERA PAN 10 SECONDS LEFT OR RIGHT.
02400 CAIN 2,"L"↔GO[LAC 1,[(=150)14]↔GO M1]
02500 CAIN 2,"R"↔GO[LAC 1,[(=150)14]↔LAPI 0,4↔GO M1]
02600
02700 CAIN 2,"0"↔GO M0 ;HALT WITH SPACEWAR RUNNING.
02800 CAIN 2," "↔GO M0 ;HALT WITH SPACEWAR RUNNING.
02900 EX: DZM FIREUP#↔SPCWAR'SSW'↔CRLF↔POP0J
03000
03100 M1: HLRZM 0,CNT0 ↔ DAPZ 0,WORD0
03200 HLRZM 1,CNT1 ↔ DAPZ 1,WORD1
03300
03400 ;FIREUP SPACE WAR MODULE - FOUR TICK SERVICE.
03500 SKIPE FIREUP↔GO M0↔SETOM FIREUP
03600 SPCWAR 4,SWJOB↔GO M0
00100 ;CART SPACE WAR JOB.
00200 ;FIRE UP SPACE WAR JOB.
00300 L0: DZM CNT0↔DZM CNT1
00400 SPCWAR 4,SWJOB
00500 OUTCHR["*"]↔LACI 7↔DAC WORD2
00600
00700 ;OLDE DIAGONOSTIC TTY LISTEN LOOP.
00800 L1: INCHRW↔CAIN "X"↔GO EX
00900 CAIGE"0"↔GO L2
01000 CAILE"8"↔GO L2
01100 ANDI 7↔DAC WORD2↔GO L1
01200 L2: CAIGE"A"↔GO L3
01300 CAILE"H"↔ANDI 7
01400 IORI 10↔DAC WORD2↔GO L1
01500 L3: CAIN 15↔OUTCHR["*"]↔GO L1
01600
01700 ; SPACE WAR OUTPUT TO RADIO TRANSMITTER.
01800
01900 SWJOB: CONSZ 40↔DISMIS ;MAKE SURE WE ARE ON THE PDP-6.
02000 SKIPE 1,WORD3↔GO[
02100 DATAO 500,WORD3↔CALLI 400024] ;ROTATE TURN TABLE.
02200 SOSLE CNT0↔GO[LAC WORD0↔GO L5]↔DZM CNT0
02300 SOSLE CNT1↔GO[LAC WORD1↔GO L5]↔DZM CNT1
02400 LAC WORD2
02500 L5: TRNE 8↔RADIO 400054; 1 SELECT ACTION RELAYS.
02600 TRNN 8↔RADIO 620054; 0 SELECT DIRECTION RELAYS.
02700 TRNE 1↔RADIO 440053; 1 STEERING MOTOR.
02800 TRNN 1↔RADIO 620053; 0 ;
02900 TRNE 2↔RADIO 410052; 1 DRIVE MOTOR.
03000 TRNN 2↔RADIO 600052; 0 ;
03100 TRNE 4↔RADIO 360051; 1 CAMERA PAN MOTOR.
03200 TRNN 4↔RADIO 570051; 0;
03300 RADIO 340050
03400 RADIO 340055
03500 DISMIS ;EXIT SPACEWAR JOB.
03600 DECLARE{WORD0,WORD1,WORD2,WORD3,CNT0,CNT1}
03700 BEND XCART; BGB 18 DECEMBER 1972 ---------------------------------
00100 XHELP:
00200 CALL(XXHELP,[[SIXBIT/CAREYEHLP/↔0↔SIXBIT/DOCBGB/]])
00300 POP0J
00400
00500 SUBR(XXHELP)FILLOC
00600 BEGIN XXHELP
00700 EXTERNAL DPYSET,DPYOUT,DPYBIG,DPYBRT,AIVECT,RIVECT,DTYO,DPYBUF
00800 SETZM INHDR
00900 INIT 17,↔SIXBIT/DSK/↔INHDR
01000 GO [FATAL(CAN'T INIT DSK)]
01100 MOVEI 1,2↔HRL 1,ARG1↔BLT 1,5
01200 LOOKUP 17,2
01300 GO [ OUTSTR[ASCIZ/HELP FILE NOT FOUND.
01400 /]↔ POP1J ]
01500 PUSH P,121
01600 PUSH P,44
01700 MOVE 1,44
01800 MOVEM 1,121
01900 LOOP: USETI 17,1
02000 SETSTS 17,0
02100 LACI 0,2
02200 MOVEM 0,PAGNUM#
02300 SOJLE 0,FOUND
02400 PGLOOP: CALL(GETCHR)
02500 GO [ OUTSTR[ASCIZ/PAGE NOT FOUND.
02600 /]↔ GO RET]
02700 CAIE 1,14
02800 JRST PGLOOP
02900 JRST PGLOOP-1
03000 FOUND: CALL(DPYSET,DPYBUF)
03100 CALL(AIVECT,[0],[=440])
03200 CALL(DPYBIG,[1])
03300 CALL(DPYBRT,[1])
03400 SETZM LPOS#
03500 CHLOOP: CALL(GETCHR)↔GO FIN
03600 CAIN 1,14↔GO FIN
03700 CAIN 1,11↔GO [ CALL(DTYO,[40])
03800 AOS 1,LPOS
03900 TRNE 1,7
04000 GO $.-4
04100 GO CHLOOP ]
04200 CALL(DTYO,1)
04300 AOS LPOS
04400 MOVE 1,1(P)
04500 CAIE 1,15
04600 GO CHLOOP
04700 SETZM LPOS
04800 CALL(RIVECT,[1000],[0])
04900 GO CHLOOP
05000 FIN: CALL(DPYOUT,[16])
05100 OUTSTR[ASCIZ/ TYPE <META>Z TO MAKE HELP GO AWAY./]
05200 RET: RELEASE 17,
05300 POP P,121
05400 MOVE 1,121
05500 CORE 1,↔GO [ FATAL(CAN'T SHRINQ CORE) ]
05600 POP P,121
05700 POP1J
05800
05900 GETCHR:
06000 SOSG INHDR+2
06100 IN 17,↔GO[ILDB 1,INHDR+1↔AOS(P)↔POP0J ]
06200 POP0J
06300 INHDR: BLOCK 3
06400 BEND XXHELP
06500 END